home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d7
/
exechk.arc
/
MYDATA.INC
< prev
next >
Wrap
Text File
|
1990-12-06
|
4KB
|
119 lines
(*******************************************************************
Variables for demo data. Can be changed to any type without modifying
the EXECHK code, (up to a limit of 65519 bytes), because the
ExeRead/Write procedures use VAR parameters.
*******************************************************************)
CONST
MaxLines = 4 ;
NameLength = 30 ;
Ok : boolean = FALSE ;
TYPE
NameType = array [ 1..MaxLines ] of
string [ NameLength ] ;
VAR
Data : NameType ;
DataLabel : NameType ;
(*******************************************************************
Data entry and display screens.
*******************************************************************)
function LabelLength : byte ;
var
Len ,
B : byte ;
begin
Len := 0 ;
for B := 1 to MaxLines do
if length ( DataLabel [ B ] ) > Len then
Len := length ( DataLabel [ B ] ) ;
LabelLength := Len ;
end ;
(*******************************************************************
Display Data
*******************************************************************)
procedure MyDataOutput ;
var
B : byte ;
begin
ClrScr ;
writeln ( 'This software is licensed to:' ) ;
writeln ( '-----------------------------' ) ;
for B := 1 to MaxLines do
begin
write ( DataLabel [ B ] : LabelLength , #178 ) ;
write ( Data [ B ] ) ;
writeln ;
end ;
writeln ( '=============================' ) ;
end ;
(*******************************************************************
INPUT
*******************************************************************)
procedure MyDataInput ;
(*******************************************************************
Only allow [Y]es, [N]o or [E]sc
*******************************************************************)
function YesNoEsc : char ;
var
junk ,
Ch : char ;
begin
writeln ( 'Press Y to continue, N to re-enter name, or ESC to cancel' ) ;
while TRUE do
begin
Ch := ReadKey ;
if KeyPressed then
Junk := ReadKey ;
Ch := UpCase ( Ch ) ;
if ( Ch = 'Y' ) or ( Ch = 'N' ) or ( Ch = #27 ) then
begin
YesNoEsc := Ch ;
EXIT ;
end ;
end ;
end ;
procedure GetUserInfo ;
var
B : byte ;
begin
for B := 1 to MaxLines do
begin
write ( DataLabel [ B ] : LabelLength , #178 ) ;
readln ( Data [ B ] ) ;
end ;
end ;
begin
while TRUE do
begin
GetUserInfo ;
MyDataOutput ;
writeln ( 'Everything OK?' ) ;
case YesNoEsc of
'Y' :
begin
Ok := TRUE ;
EXIT ;
end ;
#27 :
begin
Ok := FALSE ;
EXIT ;
end ;
'N' : ; (* Loop *)
end ;
end ;
end ;
(*******************************************************************
Initialize demo fields, labels, etc.
*******************************************************************)
procedure MyDataInit ;
begin
FillChar ( Data , SizeOf ( Data ) , #0 ) ;
DataLabel [ 1 ] := 'Name' ;
DataLabel [ 2 ] := 'Company' ;
DataLabel [ 3 ] := 'City, State' ;
DataLabel [ 4 ] := 'Serial #' ;
end ;